<%
const ForReading = 1
const ForWriting = 2
const ForAppending = 8

const YYYYdMMdDD = "YYYY-MM-DD"
const DDdMMdYYYYsHHcMMcSS = "DD-MM-YYYY HH:MM:SS"

const PRODUCTNAME = "Politie Narrowcast"

theConnection = "DSN=kabelbase;"
theReadConnection = "DSN=kabelread;"
theArchiveConnection = "DSN=archive;"
theOnlineConnection = "DSN=kabelonline;"

' the first running server is considered the master server
if application("narrowcast.server") = "" then application("narrowcast.server") = request.serverVariables("REMOTE_HOST")

dim tmpConnection
dim readConnection
dim archiveConnection
dim onlineConnection

Set tmpConnection = Server.CreateObject("ADODB.Connection")
tmpConnection.Open theConnection

function closeDatabase
	tmpConnection.Close
	set tmpConnection = nothing
end function

function openArchive
	Set archiveConnection = Server.CreateObject("ADODB.Connection")
	archiveConnection.Open theArchiveConnection
end function

function closeArchive
	archiveConnection.Close
	set archiveConnection = nothing
end function

function openOnline
	Set onlineConnection = Server.CreateObject("ADODB.Connection")
	onlineConnection.Open theOnlineConnection
end function

function closeOnline
	onlineConnection.Close
	set onlineConnection = nothing
end function

function makeParam(txt)
	dim params, result, tmpArr
	params = split(txt, "<br>")
	
	for t=lbound(params) to ubound(params)
		tmpArr = split(params(t),"=")
		if ubound(tmpArr) >= 1 then
			for r = 2 to ubound(tmpArr)
				tmpArr(1) = tmpArr(1) & tmpArr(r)
			next
			result = result & "&" & server.URLencode(trim(tmpArr(0))) & "=" & server.URLencode(trim(tmpArr(1)))
		end if
	next
	
	makeParam = result
	
end function

sub register(pid, pagename)
	set fs = CreateObject("Scripting.FileSystemObject")
	fname = server.mappath("log\" & logname(now()) & ".log")
	
	if not fs.FolderExists(server.mappath("log\host-" & request.serverVariables("REMOTE_HOST"))) then
		fs.CreateFolder(server.mappath("log\host-" & request.serverVariables("REMOTE_HOST")))
	end if
	
	if not fs.fileexists(fname) then
		set file = fs.createtextfile(fname, true)
	else
		set file = fs.openTextFile(fname, 8) ' 8=forAppending
	end if
	file.writeline now() & " [" & pid & "][" & request.serverVariables("REMOTE_HOST") & "] " & pagename
	file.close
	set file = nothing
	set fs = nothing
end sub

sub registerCentral(pid, pagename)
	set fs = CreateObject("Scripting.FileSystemObject")
	fname = server.mappath("log\kkserver.log")
	
	if not fs.fileexists(fname) then
		set file = fs.createtextfile(fname, true)
	else
		set file = fs.openTextFile(fname, 8) ' 8=forAppending
	end if
	file.writeline now() & " [" & pid & "][" & session("loggedUser") & "] " & pagename
	file.close
	set file = nothing
	set fs = nothing
end sub

sub setNP(pid, pagename, inhoud, pauze, bgImage, special, theInc)
	if request.serverVariables("REMOTE_HOST") = application("narrowcast.server") then
		application("kk_json") = "{'id': '" & pid & "', 'title': '" & replace(pagename, "'", "\'") & "', 'inhoud' : '"& replace(inhoud, "'", "\'") & "', 'pauze':'" & pauze & "', 'bgImage':'" & bgImage & "', 'special':'" & special & "'}"
	end if
end sub

function logname(d)
	logname = "host-" & request.serverVariables("REMOTE_HOST") & "\" & year(d) & fillUp(month(d),2) & fillUp(day(d),2)
end function

function serverLogname(d)
	serverLogname = "host-127.0.0.1\" & year(d) & fillUp(month(d),2) & fillUp(day(d),2)
end function

function fillUp(n, l)
	r = n
	while len(r) < l
		r = "0"& r
	wend
	fillUp = r
end function

function fillout(what, ln)
	ret = cstr(what)
	while len(ret) < ln
		ret = "0" & ret
	wend
	fillout = ret
end function

function monthname(m)
	select case m
	case 1: monthname = "januari"
	case 2: monthname = "februari"
	case 3: monthname = "maart"
	case 4: monthname = "april"
	case 5: monthname = "mei"
	case 6: monthname = "juni"
	case 7: monthname = "juli"
	case 8: monthname = "augustus"
	case 9: monthname = "september"
	case 10: monthname = "oktober"
	case 11: monthname = "november"
	case 12: monthname = "december"
	end select
end function

sub header
	%>
	<html>
		<head>
			<LINK REL="stylesheet" TYPE="text/css" HREF="style/editor.css">
			<script language="JavaScript" type="text/javascript" src="script/editor.js"></script>
			<title><%=PRODUCTNAME%> Editor - PolitieMon</title>
		</head>

		<body bgcolor="white" background="sysimages/kabelkrantbg.gif">
	<%
end sub

sub footer
	%>
		<div align="right" class="username"><%=theUser%></div>
		</body>
	</html>
	<%
end sub

function formDateToDBString(what)
	if what = "" then
		formDateToDBString = what
	else
		tmpArray = split(what, "/")
		formDateToDBString = fillout(tmpArray(2),4) & fillout(tmpArray(1),2) & fillout(tmpArray(0),2)
	end if
end function

function DBStringToFormDate(what)
	if what = "" or isnull(what) then
		DBStringToFormDate = ""
	else
		DBStringToFormDate = cint(mid(what,7,2)) & "/" & cint(mid(what,5,2)) & "/" & cint(left(what, 4))
	end if
end function

function DBStringToShortDate(what)
	if what = "" or isnull(what) then
		DBStringToShortDate = ""
	else
		DBStringToShortDate = cint(mid(what,7,2)) & "/" & cint(mid(what,5,2))
	end if
end function

function formBoolToQuery(what)
	if what = "" then
		formBoolToQuery = "0"
	else
		formBoolToQuery = "1"
	end if
end function

function dagKort(datum)
	week = array("zo", "ma", "di", "wo", "do", "vr", "za")
	dagKort = week(weekday(datum) - 1)
end function

function niceDate(dateString, formatString)
	dim da, ta
	if trim(dateString) <> ""  then
		select case formatString
		case YYYYdMMdDD
			da = split(dateString, "-")
			y = cint(da(0))
			m = cint(da(1))
			d = cint(da(2))
		case DDdMMdYYYYsHHcMMcSS
			ta = split(dateString, " ")
			da = split(ta(0), "-")
			y = cint(da(2))
			m = cint(da(1))
			d = cint(da(0))
		end select
		niceDate = cstr(d) & " " & monthname(m) & " " & cstr(y)
	else
		niceDate = "?"
	end if
end function

function pageIsScheduled(rs)
	' rs is a record from vwcontent
	ok = true
	
	vandaagString = formDateToDBString(day(now()) & "/" & month(now()) & "/" & year(now()))

	if not isnull(rs("schemaid")) then
		if not rs( dagKort(now()) ) then ok = false
		if vandaagString < rs("van") and not rs("van") = "" then ok = false
		if vandaagString > rs("tot") and not rs("tot") = "" then ok = false
	end if
	
	pageIsScheduled = ok
end function

function extdate
	extdate = getExternalHTML("http://viewer1/rel2/datetime.asp")
end function

function extnow
	extnow = getExternalHTML("http://viewer1/rel2/datetime.asp?command=now")
end function

function getExternalHTML(url)
	  'Declare the variables, and set the value of the variable url as 
	  'the full URL of the requested page.
	  Dim xml, strData
	
	  'Next, create an instance of the MS XMLhttp component.
	  'old version, unstable server side performance so upgrade if you can
	  ' *** OLD *** Set xml = Server.CreateObject("Microsoft.XMLHTTP")
		
	  'new version, better server side performance
	  Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
	
	  'Now open the connection, and send the request to the remote server. You 
	  'need to set the optional Async parameter to True on the open method for 
	  'this script to work. Otherwise, the waitForResponse method used 
	  'below will have no effect.
	  xml.Open "GET", url, true    ' the True specifies an asynchronous request
	  Call xml.Send()
	
	  'Turn off error handling
	  On Error Resume Next
	  
	  'Wait for up to 3 seconds if we've not gotten the data yet
	  If xml.readyState <> 4 then
	    xml.waitForResponse 60
	  End If
	
	  'Did an error occur?  If so, use a default value for our data
	  If Err.Number <> 0 then
	    strData = "error: " & err.description
	  Else
	    If (xml.readyState <> 4) Or (xml.Status <> 200) Then
	      'Abort the XMLHttp request
	      xml.Abort
	            
		  strData = "error xml.readyState=" & xml.readyState
	    Else
	      strData = xml.ResponseText
	    End If
	  End If
	getExternalHTML = strData
end function
%>